home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / B-Book Series / (k)b1.d64 / new'employee.l < prev    next >
Text File  |  2007-02-28  |  3KB  |  86 lines
  1. 0010 // CREATE A NEW EMPLOYEE / CLASSIFICATION FILE
  2. 0020 DIM NAME$ OF 20, CLASS$ OF 20
  3. 0030 OPEN FILE 2,"0:EMPLOYEE",WRITE
  4. 0040 REPEAT 
  5. 0050 TAKE'IN("EMPLOYEE NAME:","A",NAME$,20)
  6. 0060 IF NAME$>"" THEN
  7. 0070 REPEAT 
  8. 0080 TAKE'IN("CLASSIFICATION:","B",CLASS$,20)
  9. 0090 UNTIL CLASS$>""
  10. 0100 WRITE FILE 2: NAME$,CLASS$
  11. 0110 ENDIF 
  12. 0120 UNTIL NAME$=""
  13. 0130 CLOSE
  14. 0140 //PROCEDURES FOLLOW
  15. 0150 //
  16. 0160 PROC TAKE'IN(PROMPT$,VALID$,REF REPLY$,MAX) CLOSED
  17. 0170 Z:=ZONE
  18. 0180 ZONE 0
  19. 0190 PRINT PROMPT$,
  20. 0200 PRINT "<", //                      LEFT SIDE
  21. 0210 FOR X:=1 TO MAX DO PRINT " ", //   BLANK OUT INPUT AREA
  22. 0220 PRINT ">", //                      RIGHT SIDE
  23. 0230 FOR X:=1 TO MAX+1 DO PRINT "¥", // CURSOR LEFT
  24. 0240 FETCH(REPLY$,VALID$,MAX)
  25. 0250 PRINT  //                          CARRIAGE RETURN
  26. 0260 ZONE Z
  27. 0270 ENDPROC TAKE'IN
  28. 0280 //
  29. 0290 PROC FETCH(REF A$,V$,MAX) CLOSED
  30. 0300 DIM VALID$ OF 40, B$ OF 1
  31. 0310 // IF V$ = "A" THEN THE ALPHABET IS USED (PLUS SPACE)
  32. 0320 // IF V$ = "D" THEN THE DIGITS ARE USED
  33. 0330 // IF V$ = "B" THEN BOTH ALPHABET AND DIGITS ARE USED (PLUS SPACE)
  34. 0340 // OTHERWISE VALID$ IS SET TO THE VALUE AS SENT
  35. 0350 // NOTE: >>> CARRIAGE RETURN AND DELETE KEY ARE ADDED TO VALID$
  36. 0360 Z:=ZONE
  37. 0370 ZONE 0
  38. 0380 A$:=""
  39. 0390 CASE V$ OF
  40. 0400 WHEN "A"
  41. 0410 VALID$:="ABCDEFGHIJKLMNOPQRSTUVWXYZ "
  42. 0420 WHEN "D"
  43. 0430 VALID$:="0123456789"
  44. 0440 WHEN "B"
  45. 0450 VALID$:="ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789"
  46. 0460 OTHERWISE 
  47. 0470 VALID$:=V$
  48. 0480 ENDCASE 
  49. 0490 DONE:=FALSE; NUM:=0
  50. 0500 REPEAT 
  51. 0510 GET'VALID(B$,VALID$+CHR$(13)+CHR$(20))
  52. 0520 CASE B$ OF
  53. 0530 WHEN CHR$(13) // CARRIAGE RETURN
  54. 0540 DONE:=TRUE
  55. 0550 WHEN CHR$(20) // DELETE KEY
  56. 0560 IF NUM THEN // ONLY DO IF ALREADY HAVE SOMETHING
  57. 0570 NUM:-1 //    MINUS ONE FOR NUMBER IN STRING
  58. 0580 PRINT "¥ ¥", // CURSOR LEFT SPACE CURSOR LEFT
  59. 0590 A$:=A$(1:NUM)
  60. 0600 ENDIF 
  61. 0610 OTHERWISE  //    ALL OTHER VALID CHARACTERS
  62. 0620 IF NUM<MAX THEN // DON'T GO PAST MAXIMUM
  63. 0630 A$:=A$+B$ //  ADD CHARACTER TO THE STRINGRETURN NEEDED
  64. 0640 NUM:+1 //     ADD 1 TO THE COUNT OF CHARACTERS
  65. 0650 PRINT B$, //  PRINT THE CHARACTER
  66. 0660 ENDIF 
  67. 0670 ENDCASE 
  68. 0680 UNTIL DONE
  69. 0690 ZONE Z
  70. 0700 ENDPROC FETCH
  71. 0710 //
  72. 0720 PROC GET'VALID(REF C$,VALID$) CLOSED
  73. 0730 REPEAT 
  74. 0740 GET'CHAR(C$)
  75. 0750 UNTIL C$ IN VALID$
  76. 0760 ENDPROC GET'VALID
  77. 0770 //
  78. 0780 PROC GET'CHAR(REF C$) CLOSED
  79. 0790 REPEAT 
  80. 0800 C$:=KEY$
  81. 0810 UNTIL C$="" //                    CLEAR BUFFER
  82. 0820 REPEAT 
  83. 0830 C$:=KEY$
  84. 0840 UNTIL C$>"" //                    WAIT FOR KEY
  85. 0850 ENDPROC GET'CHAR
  86.